home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Leisure Game Pak
/
Leisure Game Pak.iso
/
lpgame1
/
04
/
source
/
mouse.pas
< prev
next >
Wrap
Pascal/Delphi Source File
|
1994-08-17
|
7KB
|
281 lines
UNIT MOUSE;
{$F+}
INTERFACE
CONST NO_MOUSEBUTTON = 0;
LEFTMOUSEBUTTON = 1;
RIGHTMOUSEBUTTON = 2;
MIDDLEMOUSEBUTTON = 4;
HARD_DRAG = TRUE; (* not interruptable *)
SOFT_DRAG = FALSE; (* interruptable *)
FUNCTION HasMouse : BOOLEAN;
PROCEDURE ShowMouse;
PROCEDURE ShowMouseReally;
PROCEDURE HideMouse;
FUNCTION GetMousePos(VAR x, y : WORD) : BYTE;
{ GetMousePos returns the button pressed }
PROCEDURE SetMousePos(x, y : WORD);
FUNCTION WaitMouseButtons(none_ok, left_ok,
right_ok, both_ok : BOOLEAN) : BYTE;
{ waits until a valid set of mouse buttons is pressed }
PROCEDURE ButtonPressed(Button : WORD; VAR x, y, but, count : WORD);
PROCEDURE ButtonReleased(Button : WORD; VAR x, y, but, count : WORD);
PROCEDURE MouseXRange (min, max : WORD);
PROCEDURE MouseYRange (min, max : WORD);
PROCEDURE MouseMove(VAR dx, dy : INTEGER);
PROCEDURE SetMouseSpeed(sx, sy : WORD);
PROCEDURE SetMouseButtonProc(Buttons : WORD; ProcPtr : POINTER);
PROCEDURE HideMouseIn(x1, y1, dx, dy : WORD);
FUNCTION DragMouse(x2, y2 : INTEGER;
hard_drag : BOOLEAN) : BOOLEAN;
FUNCTION GetMouseButton : BYTE;
{GetMouseButton returns the button pressed }
FUNCTION MouseTouched : BOOLEAN;
{ TRUE, if Button is pressed or mouse was moved }
IMPLEMENTATION
USES DOS, Timing;
{ to show mouse REALLY, count in TimesHidden how often you hid the mouse }
CONST TimesHidden : WORD = 1;
mouse_step : WORD = 1; (* to adjust mouse-drag-speed *)
mouse_delay : WORD = 0;
VAR R : Registers;
FUNCTION HasMouse : boolean;
VAR MouseInt: POINTER;
BEGIN
R.AX := 0; R.BX := 0;
GetIntVec($33, MouseInt);
IF (MouseInt <> NIL) THEN Intr($33,R);
HasMouse := (R.BX > 0);
END; { HasMouse }
PROCEDURE ShowMouse;
BEGIN R.AX := 1; Intr($33,R);
IF (TimesHidden > 0) THEN DEC(TimesHidden);
END; { ShowMouse }
{ to show mouse REALLY, you have to show it as often as you hid it earlier }
PROCEDURE ShowMouseReally;
BEGIN
REPEAT
ShowMouse;
UNTIL (TimesHidden = 0);
END; { ShowMouseReally }
PROCEDURE HideMouse;
BEGIN R.AX := 2; Intr($33,R);
IF (TimesHidden < 65535) THEN INC(TimesHidden);
END; { HideMouse }
{GetMousePos returns the button pressed }
FUNCTION GetMousePos(VAR x, y : WORD) : BYTE;
BEGIN
R.AX := 3; Intr($33,R);
x := R.CX; y:=R.DX;
GetMousePos := R.BX;
END; { GetMousePos }
PROCEDURE SetMousePos(x,y : WORD);
BEGIN
R.AX := 4; R.CX := x; R.DX := y;
Intr($33,R);
END; { SetMousePos }
FUNCTION WaitMouseButtons(none_ok, left_ok,
right_ok, both_ok : BOOLEAN) : BYTE;
VAR x, y : WORD;
b : BYTE;
ok : BOOLEAN;
BEGIN
ok := FALSE;
REPEAT
b := GetMousePos(x,y);
CASE b OF
NO_MOUSEBUTTON : ok := none_ok;
LEFTMOUSEBUTTON : ok := left_ok;
RIGHTMOUSEBUTTON : ok := right_ok;
LEFTMOUSEBUTTON +
RIGHTMOUSEBUTTON : ok := both_ok;
END; { CASE }
UNTIL (ok);
WaitMouseButtons := b;
END; {WaitMouseButtons }
PROCEDURE ButtonPressed(Button : WORD;
VAR x, y, but, count : WORD);
BEGIN
R.AX := 5; R.BX := Button;
Intr($33,R);
x := R.CX; y := R.DX; but := R.AX; count := R.BX;
END; { ButtonPressed }
PROCEDURE ButtonReleased(Button : WORD;
VAR x, y, but, count : WORD);
BEGIN
R.AX := 6; R.BX := Button;
Intr($33,R);
x := R.CX; y := R.DX; but := R.AX; count := R.BX;
END; { ButtonReleased }
PROCEDURE MouseXRange (min, max : WORD);
BEGIN
R.AX := 7; R.CX := min; R.DX := max;
Intr($33,R);
END; { MouseXRange }
PROCEDURE MouseYRange (min, max : WORD);
BEGIN
R.AX := 8; R.CX := min; R.DX := max;
Intr($33,R);
END; { MouseYRange }
PROCEDURE SetMousePointer(width, height : WORD; data : POINTER);
BEGIN
R.AX := 9; R.BX := width; R.CX := height;
R.ES := Seg(data^); R.DX := Ofs(data^);
Intr($33,R);
END; { SetMousePointer }
PROCEDURE MouseMove(VAR dx, dy : INTEGER);
BEGIN
R.AX := 11; Intr($33,R);
dx := INTEGER(R.CX); dy := INTEGER(R.DX)
END; { MouseMove }
PROCEDURE SetMouseButtonProc(Buttons : WORD; ProcPtr : POINTER);
BEGIN
R.AX := 12; R.CX := Buttons;
R.DX := Seg(ProcPtr^); R.ES := Ofs(ProcPtr^);
Intr($33,R);
END; { SetMouseButtonProc }
PROCEDURE SetMouseSpeed(sx, sy : WORD);
BEGIN
R.AX := 15; R.CX := sx; R.DX := sy;
Intr($33,R)
END; { SetMouseSpeed }
PROCEDURE HideMouseIn(x1, y1, dx, dy : WORD);
BEGIN
R.AX := 16;
R.CX := x1; R.DX := y1;
R.SI := x1 + PRED(dx); R.DI := y1 + PRED(dy);
Intr($33,R);
END; { HideMouseIn }
{ .............................. special routines }
{ drag mousepointer to the position (x2,y2) }
FUNCTION DragMouse(x2, y2 : INTEGER;
hard_drag : BOOLEAN) : BOOLEAN;
CONST MAXMOVE = 120;
MINMEASURE = 200;
VAR dx, dy,
dmx, dmy: INTEGER;
b,
x, y,
x1, y1 : WORD;
mmove,
t, tmax : LONGINT;
drag_ok,
y_bow : BOOLEAN;
BEGIN
MouseMove(dmx, dmy); { reset mousemoves }
b := GetMousePos(x1, y1);
dx := x2 - x1;
dy := y2 - y1;
y_bow := abs(dx) > abs(dy);
if y_bow then
tmax := abs(dx)
else
tmax := abs(dy);
IF (tmax > MINMEASURE) THEN (* adjust drag time *)
StartMeasure;
mmove := 0;
t := 1; { stop immediately if tmax = 0 }
drag_ok := TRUE;
WHILE (drag_ok) AND (t < tmax) DO
BEGIN
MouseMove(dmx, dmy); { get mousemoves }
INC(mmove, ABS(dmx) + ABS(dmy));
{ see whether soft_drag is still ok ... x,y are just dummies }
drag_ok := (hard_drag) OR
((GetMousePos(x,y) = NO_MOUSEBUTTON) AND
(mmove <= MAXMOVE));
{ the linear part of the drag ... }
x := x1 + (t * dx) DIV tmax;
y := y1 + (t * dy) DIV tmax;
{ ... plus the bow,
note: the bow part has to be 0 for t=0 and t=tmax }
IF (y_bow) THEN (* bow y coord *)
INC(y,t - (t*t) DIV tmax)
else
INC(x,t - (t*t) DIV tmax);
SetMousePos(x,y);
INC(t, mouse_step);
MyDelay(mouse_delay);
END; (* WHILE *)
IF drag_ok THEN BEGIN
SetMousePos(x2, y2);
IF (tmax > MINMEASURE) THEN (* adjust drag time *)
GetStepDelay(tmax, tmax, mouse_step, mouse_delay);
END; (* if *)
DragMouse := drag_ok;
END; { DragMouse }
{GetMouseButton returns the button pressed }
FUNCTION GetMouseButton : BYTE;
BEGIN
R.AX := 3; Intr($33,R);
GetMouseButton := R.BX;
END; { GetMouseButton }
FUNCTION MouseTouched : BOOLEAN;
{ TRUE, if Button is pressed or mouse was moved }
VAR dx, dy : INTEGER;
BEGIN
MouseMove(dx, dy);
MouseTouched := (dx <> 0) OR (dy <> 0) OR
(GetMouseButton <> NO_MOUSEBUTTON);
END; { MouseTouched }
END. { UNIT MOUSE }